home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE23 / SURVIVE / uAllo.pas < prev    next >
Pascal/Delphi Source File  |  1997-05-20  |  4KB  |  169 lines
  1. unit uAllo;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, uBase;
  7.  
  8. type
  9.   TCredit = class
  10.   public
  11.     CreditNo: LongInt;
  12.     Amount,
  13.     AmountRemaining: LongInt;
  14.     PaymentByMethod: TAmountsList;
  15.     constructor Create(aNumMethods: Integer);
  16.     destructor Destroy; override;
  17.   end;
  18.  
  19.   TCreditList = class(TList)
  20.   protected
  21.     function GetItem(aIndex: Integer): TCredit;
  22.   public
  23.     procedure Add(aCreditNo: LongInt; aAmount: LongInt);
  24.     procedure Delete(aCreditNo: LongInt);
  25.     property Items[aIndex: Integer]: TCredit read GetItem; default;
  26.   end;
  27.  
  28.   TAllocationInfo = class(TPersistent)
  29.   protected
  30.     function GetMethodCount: Integer;
  31.     function GetMethodName(aIndex: Integer): string;
  32.   public
  33.     MethodAmounts: TAmountsList;
  34.     MethodAmountsRemaining: TAmountsList;
  35.     Credits: TCreditList;
  36.     TotalPaymentRemaining: LongInt;
  37.  
  38.     constructor Create;
  39.     destructor Destroy; override;
  40.     procedure Clear;
  41.     procedure ComputeTotalByCredit(aCreditNo: LongInt);
  42.     procedure ComputeTotalByMethod(aMethodNo: Integer);
  43.  
  44.     property MethodCount: Integer
  45.       read GetMethodCount;
  46.     property MethodName[aIndex: Integer]: string
  47.       read GetMethodName;
  48.   end;
  49.  
  50. implementation
  51.  
  52. uses
  53.   dmData;
  54.  
  55. { TCredit }
  56.  
  57. constructor TCredit.Create(aNumMethods: Integer);
  58. begin
  59.   inherited Create;
  60.   PaymentByMethod := TAmountsList.Create;
  61.   while aNumMethods > 0 do begin
  62.     PaymentByMethod.Add(0);
  63.     Dec(aNumMethods);
  64.   end;
  65. end;
  66.  
  67. destructor TCredit.Destroy;
  68. begin
  69.   PaymentByMethod.Free;
  70.   inherited Destroy;
  71. end;
  72.  
  73. { TCreditList }
  74.  
  75. procedure TCreditList.Add(aCreditNo: LongInt; aAmount: LongInt);
  76. var
  77.   Credit: TCredit;
  78. begin
  79.   Credit := TCredit.Create(dmDataModule.PaymentMethodsList.Count);
  80.   Credit.CreditNo := aCreditNo;
  81.   Credit.Amount := aAmount;
  82.   Credit.AmountRemaining := aAmount;
  83.   inherited Add(Credit);
  84. end;
  85.  
  86. procedure TCreditList.Delete(aCreditNo: LongInt);
  87. var
  88.   I: Integer;
  89. begin
  90.   for I := 0 to Count - 1 do
  91.     if Items[I].CreditNo = aCreditNo then begin
  92.       inherited Delete(I);
  93.       Break;
  94.     end;
  95. end;
  96.  
  97. function TCreditList.GetItem(aIndex: Integer): TCredit;
  98. begin
  99.   Result := nil;
  100.   if aIndex < Count then
  101.     Result := TCredit(inherited Items[aIndex]);
  102. end;
  103.  
  104. { TAllocationInfo }
  105.  
  106. constructor TAllocationInfo.Create;
  107. var
  108.   I: Integer;
  109. begin
  110.   inherited Create;
  111.   MethodAmounts := TAmountsList.Create;
  112.   MethodAmountsRemaining := TAmountsList.Create;
  113.   Credits := TCreditList.Create;
  114.  
  115.   for I := 1 to MethodCount do begin
  116.     MethodAmounts.Add(0);
  117.     MethodAmountsRemaining.Add(0);
  118.   end;
  119. end;
  120.  
  121. destructor TAllocationInfo.Destroy;
  122. begin
  123.   MethodAmounts.Free;
  124.   MethodAmountsRemaining.Free;
  125.   Credits.Free;
  126.   inherited Destroy;
  127. end;
  128.  
  129. procedure TAllocationInfo.Clear;
  130. var
  131.   I, J: Integer;
  132. begin
  133.   {!! markers }
  134.   for J := 0 to MethodCount - 1 do begin
  135.     MethodAmounts[J] := 0;
  136.     MethodAmountsRemaining[J] := 0;
  137.   end;
  138. end;
  139.  
  140. procedure TAllocationInfo.ComputeTotalByCredit(aCreditNo: LongInt);
  141. begin
  142. end;
  143.  
  144. procedure TAllocationInfo.ComputeTotalByMethod(aMethodNo: Integer);
  145. var
  146.   I: Integer;
  147. begin
  148.   MethodAmountsRemaining[aMethodNo] := MethodAmounts[aMethodNo];
  149.   for I := 0 to Credits.Count - 1 do
  150.     MethodAmountsRemaining[aMethodNo] := MethodAmountsRemaining[aMethodNo] -
  151.                                          Credits[I].PaymentByMethod[aMethodNo];
  152.  
  153.   TotalPaymentRemaining := 0;
  154.   for I := 0 to MethodCount - 1 do
  155.     Inc(TotalPaymentRemaining, MethodAmountsRemaining[I]);
  156. end;
  157.  
  158. function TAllocationInfo.GetMethodCount: Integer;
  159. begin
  160.   Result := dmDataModule.PaymentMethodsList.Count;
  161. end;
  162.  
  163. function TAllocationInfo.GetMethodName(aIndex: Integer): string;
  164. begin
  165.   Result := dmDataModule.PaymentMethodsList[aIndex];
  166. end;
  167.  
  168. end.
  169.